ListSymbols.mesa 25-0CT-77 15:08:14 Page 1 

-- file 1 istsymbols.mesa 

-- last modified by Sandman, October 17, 1977 9:10 AM 

DIRECTORY 

AltoDefs: FROM "altodefs". 
BcdDefs: FROM "bcddefs", 
CommanderDefs: FROM "commanderdef s", 
lODefs: FROM "iodefs", 
ListerDefs: FROM "1 isterdef s" , 
OutputOefs: FROM "outputdef s" , 
SegmentDefs: FROM "segmentdef s", 
StringDefs: FROM "stringdefs", 
SymbolTableDefs: FROM "symbol tabledefs" . 
SymOefs: FROM "symdefs"; 

DEFINITIONS FROM ListerDefs, OutputOefs. SymDefs; 

ListSymbols: PROGRAM IMPORTS ListerDefs, CommanderDefs, lODefs, OutputOefs, SegmentDefs, StringDefs, Sy 
**mbolTableDefs 

EXPORTS ListerDefs = 

BEGIN 

FileSegmentHandle: TYPE = SegmentDefs. Fi leSegmentHandle; 

symbols : SymbolTableDefs .SymbolTableBase; 

PutSubString: PROCEDURE [ss; StringDefs .Substring] = 
BEGIN 

i: CARDINAL; 
FOR i IN [ss. offset. .ss. off set+ss. length) 

DO 

PutCbar[ss .base[i]] 

ENDLOOP; 
RETURN 
END; 

PrintSymbols: PROCEDURE = 
BEGIN 

ctx: CTXIndex; 
ctx 4- FIRST[CTXIndex]; 

UNTIL ctx = LOOPHOLE[symbols.stHandle.ctxSize, CTXIndex] 
DO 

PutCR; PrintContext[ctx]; 

ctx ♦- ctx + (WITH (symbol s.ctxb^-ctx) SELECT FROM 
included => SIZE [included CTXRecord], 
imported => SIZE [imported CTXRecord], 
ENOCASE => SIZE [simple CTXRecord]); 
ENDLOOP; 
PutCR; RETURN 
END; 

PrintContext: PROCEDURE [ctx: CTXIndex] « 
BEGIN 

sei, root: ISEIndex; 
typesei: SEIndex; 
addr: bitaddress; 
PutCR; 

PutSlring['*Context : "]: printindex[ctx] ; 
IF (symbols. ctxb+ctx).ctxlevel n IZ THEN 
BEGIN PutString[", static level: "]; 
PutDecimal [( symbols . ctxb+ctx) . ctx level ] ; 
END; 
WITH (symbols. ctxb+ctx) SELECT FROM 
included => 

BEGIN PutString[" , copied from [file: "]; 
pr jntht i [( symbols .mdb+c txmodule) .mdht i ] ; 
PutStr ing[" , context: "]; print index[ctxmap] ; 
PutChar[' ]]; 
END; 
imported => 

BEGIN PutString[", imported from file: "]; 

pr in tht i [( symbols .mdb+( symbol s.ctxb+includeLink). ctxmodule) .mdh ti ]; 
END; 
CNDCASE; 
root «- sei <- ( symbol s . ctxb + ctx ). sel ist ; 
WHTI r sei /y STNull DO 
OPEN (symbol s . seb+se i ) ; 
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indent[2]; 
printseifsei]; 

PutString[" ["]; printindex[sei]; PutChar['3]; 
IF public THEN PutString[" [public]"]; 
IF external THEN PutString[" [external]"]; 
IF mark3 
THEN 
BEGIN 

PutString[", type = "]; 
IF idtype = typeTYPE 
THEN 

BEGIN typesei ^ idinfo; 
PutString["TYPE, equated to: "]; 
printtype[typesei]; 
IF typelink[sei] # SENull 
THEN 

BEGIN PutString[", tag code: "]; 
PutDecimal[idvalue]; 
END; 
END 
ELSE 

BEGIN printtype[idtype]; typesei ♦• idtype; 
IF writeonce THEN PutString[" [read only]"]; 
IF constant THEN PutString[" [constant]"]; 
IF ~mark4 
THEN 

BEGIN PutString[", references: "]; 
PutDecimal[idinfo]; 
END 
ELSE 
BEGIN 

SELECT TRUE FROM 
constant => 

BEGIN PutString[". value: "]; 
IF ABS[idvalue] <= 1000 
THEN PutDecimal[idvalue] 
ELSE PiitOctal[idvalue]; 
END; 
(external AND symbols . stHandle.def initionsFi le) »> 
BEGIN PutString[", index: "]; 
PutDecimal [idvalue]; 
END; 



ENDCASE => 

BEGIN addr <- idvalue; 
PutString[", address: "]; 
PutOctal[addr.wd]; PutChar[' ]; 



PutChar['[] 
PutChar[' :] 
PutChar[']] 
END; 



PutOctal[addr.bd]; 
PutOctal[idinfo]: 



END; 



END; 
pr in ttypeinfo[typesei , 4]; 
END; 
IF (sei ♦- symbols . nextse[sei ]) 
ENDLOOP; 
RETURN 
END; 



root THEN EXIT; 



printhti: PROCEDURE [hti: HTIndex] = 
BEGIN 

desc: StringDef s . SubStri ngDescriptor ; 
s: StringDefs .Substring = @desc; 
ir hti = HTNull 

THCN PutSlring["( anonymous) "] 
CLSE 
BEGIN 

symbols .SubStr ingrorHash[s . hti]; Pu tSubSlr ing[s] ; 
END; 
RETURN 
END; 



printsei: PROCEDURE [sei: ISEIndex] = 
BEGIN 
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printhti[IF sei=SENun THEN HTNull ELSE (symbols .seb+sei) . htptr] ; 

RETURN 

END; 

TypePrintName: ARRAY TypeClass OF STRING = [ 

"mode", "basic", "enumerated", "record", "pointer", "array", 
"arraydesc", "transfer", "definition", "union", "subrange"]; 

PutTypeName: PROCEDURE[n: TypeClass] « 
BEGIN 

PutString[TypePrintName[n]]; RETURN 
END; 

ModePrintName: ARRAY TransferMode OF STRING = [ 

"procedure", "port", "signal", "error", "program", "inline", "none"]; 

PutModeName: PROCEDURE[n: TransferMode] = 
BEGIN 

PutString[ModePrintName[n]]; RETURN 
END; 

type! ink: PROCEDURE [type: SEIndex] RETURNS [SEIndex] « 
BEGIN 

sei: CSEIndex = symbol s . undertype[type] ; 
RETURN [WITH se: ( symbol s . seb+sei ) SELECT FROM 
record => 

WITH se SELECT FROM 
linked => linktype, 
ENDCASE => SENull , 
ENDCASE => SENull] 
END; 

printtype: PROCEDURE [sei: SEIndex] - 
BEGIN 

tsei: SEIndex; 
IF sei = SENull 

THEN PutString["?"] 
ELSE 

WITH t: (symbols. seb+sei) SELECT FROM 
constructor => 

WITH t SELECT FROM 

transfer => PutModeName[mode] ; 
ENDCASE => PutTypeName[t.typetag]; 
id => 
BEGIN 

printsei[LOOPHOLE[sei , ISEIndex]]; tsei ^ sei; 
UNTIL (tsei ♦• typel ink[ tsei ]) = SENull 
DO 

WITH (symbols. seb+tsei) SELECT FROM 
id => 

BEGIN PutChar[' ]; 
printsei[LOOPHOLE[tsei , ISEIndex]]; 
END; 
ENDCASE; 
ENDLOOP; 
END; 
ENDCASE; 
PutString[" ["]; print index[sei] ; PutChar[']]; 
RETURN 
END; 

printtypeinfo: PROCEDURE [sei: SEIndex. nblanks: INTEGER] = 
BEGIN 

IF sei if SfNun 
THEN 

WITH s: (symbols. seb+sei) SELECT FROM 
constructor => 

BEGIN indent[nblanks]: 

PutChar['[]: pr in t i ndex[sei ] : PutString["] "]; 

WITH s Sri EOT FROM 

transfer => PutModeName[mode] ; 
ENDCASr => PutTypeName[s. typetag]: 
WITH t: s SELECT FROM 
basic => 
BEGIN 
IF t. ordered THEN PutString[" (ordered)"]; 
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PutString[", code: "]; 

PutD8Cimal[t.cocl8]; 

PutString[", length: "]; PutOctal [t. length]; 

END; 
enumerated »> 

BEGIN 

IF t. ordered THEN PutString[" (ordered)"]; 

PutString[", value ctx: '♦]; 

printindex[t. valuectx] ; 

PutString['* , nvalues: "]; 

PutDecimal[t.n values]; 

END; 
record => 

BEGIN 

IF t.machineDep THEN PutString[" (Machine Dependent)"]; 

IF t.unifield THEN PutString[" (unif ield)"] ; 

IF t. variant THEN PutString[" (variant)"]; 

outrecordctx['\ field ctx: ", L0OPH0LE[sei , recordCSEIndex]] ; 

WITH (symbols. ctxb+t.fieldctx) SELECT FROM 
includvi => 

IF ^'Ctxcomplete THEN PutString[" [partial]"]; 
imported => PutString[" [partial]"]; 
ENDCASE; 

WITH t SELECT FROM 
linked => 

BEGIN PutString[", link: "]; 
printtype[l inktype] ; 
END; 
ENDCASE; 

END; 
pointer »> 

BEGIN 

IF t. ordered THEN PutString[" (ordered)"]; 

IF t. readonly THEN PutString[" (readonly)"]; 

PutString[" , pointing to: "]; 

print type[t. pointed to type]; 

p'^inttypeinfo[t .pointedtotype, nblanks+2]; 

END; 
array, arraydesc => 

BEGIN 

IF t. packed THEN PutString[" (packed)"]; 

PutString[", index type: "]; 

print type[t. index type]; 

PutString[", component type: "]; 

printtype[t. componenttype] ; 

printtypeinfo[ t. index type, nblanks+2]; 

print typeinfo[t. componenttype, nblanks+2]; 

END; 
transfer => 

BEGIN 

outrecordctx[" , input ctx: ", t.inrecord]; 

outrecordctx[" , output ctx: ", t . outrecord] ; 

END; 
definition => 

BEGIN 

PutString[**, ctx: "]; printindex[ t . defCtx] ; 

PutString[", number of gfi's: "]; 

PutDecimal[t.nGfi]; 

END; 
union => 

BEGIN 

IF t.overlayed THEN PutString[" (overlayed) "]; 

IF t. controlled 
THEN 

BEGIN PutString[", tag: "]; pr inLsei[ t . tagse i] ; 
END; 

Puts tr ing[" , tag type: "]; 

pr inttype[( symbol s.seb + t.tagsei). id type]: 

PutString[", case ctx: "]; pr i nt i ndex[ t . casectx] ; 

END; 
subrange => 

BfGIN 

PutString[" of: "]; pr i nttype[t . range type] ; 

ir t. empty THTN PutString[" (empty) "]; 

IF t. filled 
THEN 
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BEGIN 

PutString[" origin: "]; PutDecimal[t. origin]; 
PutString[", range: "]; 
IF t. flexible 
THEN PutChar['*] 
ELSE PutDecimal[t. range]; 
END; 
END; 
ENDCASE; 
END; 
ENDCASE; 
RETURN 
END; 

outrecordctx: PROCEDURE [message: STRING, sei: recordCSEIndex] = 
BEGIN 

PutString[message]; 
IF sei = SENull 

THEN PutString["NIL'»] 

ELSE printindex[(symbols.seb+sei) .f ieldctx]; 
RETURN 
END; 

printindex: PROCEDURE [v: UNSPECIFIED] « 
BEGIN 

PutDecimal[v]; RETURN 
END; 

indent: PROCEDURE [n: CARDINAL] = 
BEGIN 
PutCR; 

THROUGH [l..n/8] DO PutTab[] ENDLOOP; 
THROUGH [l..n MOD 8] DO PutChar[' ] ENDLOOP; 
RETURN 
END; 

Symbols: PROCEDURE[root : STRING] = 
BEGIN OPEN StringDefs; 
i: CARDINAL; 
bcdFile: STRING ♦• [40]; 
sseg: FileSegmentHandle; 
AppendSt ring [bcdFile, root]; 
FOR i IN [0. .bcdFile. length) DO 

IF bcdFile[i] = ' . THEN EXIT; 

REPEAT FINISHED => AppendStr ing[bcdFi 1e , " . bed"] ; 

ENDLOOP; 
BEGIN 
sseg *- Load[bcdFile 

INoCode => RESUME; 

NoFGT => RESUME; 

NoSymbols, IncorrectVersion => 

BEGIN IODefs.WriteString["Bad format"]; GOTO giveup END; 

SegmentDefs. FileNameError => 

BEGIN IODefs.WriteString["File not found"]; GOTO giveup END 

] . symbol seg; 
symbols*-Symbo1TableDefs. AcquireSymbolTable[ 

Symbo 1 Tab leDefs.TableForSegment[ sseg]]; 
-- this kludge because ctxLimit not in SymbolTable frame 
OpenOutput[root.".sl"]; 
Wr1teFileID[bcdFile]; 
PrintSymbols[]; 
CloseOutput[] ; 
EXITS giveup => NULL; 
END; 
END; 

SymbolSegment: PROCFDURE[root : STRING, base: AUoDef s . PageNuniber , pages: AltoDef s . PageCoun t] 
BfGTN OPEN Str ingOefs; 
i: CARDINAL; 

bcdFile: STRING ^ [40]; 
sseg: FileSegmentHandle; 
AppendStr ing[bcdF i 1 e , root] : 
FOR i IN [0. .bcdFile. length) DO 
IF bcdFile[i] = ' . THEN EXIT; 
RfPFAT FINISHFD => AppendStr ing[bcdF i 1 e ,". bed"] ; 
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ENDLOOP; 
BEGIN OPEN SegmentDefs; 
sseg ♦• NewFneSegment[ 

NewFne[bcdFile, Read, DefaultVersion ! 
FileNameError => GO TO NoFile], 

base, pages, Read I 

Inval idSegmentSize => GO TO BadSegment]; 
sseg. class ♦• symbols; 
symbols ♦■ SymbolTableDef s.AcquireSymbolTab1e[SymbolTableDefs .TableForSegment[sseg I 

Inval idSegmentSize => GO TO BadSegment]]; 
-- this kludge because ctxLimit not in SymbolTable frame 
OpenOutput[root , " .si"] ; 
PutString["Symbol Table in file: "]; 
PutString[root]; 
PutString[". base: "]; 
PutDecimal[bas8]; 
PutString['\ pages: "]; 
PutDecimal[pages]; 
PutCR[]; 

WriteSymbolID[]; 
PrintSymbols[]; 
CloseOutput[]; 
EXITS 

NoFile => IODefs.WriteString["File not found"]; 

BadSegment => lODef s .Wr1teString["Bad Segment"]; 
END; 
END; 

WriteSymbolID: PROCEDURE = 
BEGIN OPEN symbols. stHandle; 
octal3: NumberFormat = 

NumberFormat[base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE]; 
PutStr1ng[" Created "]; 
PutTime[ vers ion. time]; 
PutString[" by "]; 
PutNumbe reversion .net,octal3]; 
PutChar['#]; 

PutNumber[ vers ion . host , octal 3] ; 
PutChar['#]; 

IF version .zapped THEN PutString[" zappedlll"]; 
PutCRF]; 

PutString[" Creator "]; 
PutTime[ creator. time]; 
PutString[" "]; 

Put Number [ere a tor. net,octal3]; 
PutChar['#]; 

PutNumber[ creator .host,octal3]; 
PutChar['#]; 

IF creator. zapped THEN PutString[" zapped! 1!"]; 
PutCR[]; PutCR[]; 
RETURN 
END; 

command : CommanderDef s .CommandBlockHandle; 

command *- CommanderDef s .AddCommand[ "Symbol s" , LOOPHOLE [Symbol s] , 1] ; 
command . params[0] <- [type: string, prompt: "Filename"]; 

command ♦- CommanderDefs . AddCommand["SymbolSegmen t" ,LOOPflOLE[SymbolSegmen t] , 3] ; 
command . params[0] ♦- [type: string, prompt: "Filename"]; 
command . params[l] ♦- [type: numeric, prompt: "Base"]; 
command . params[2] <- [type: numeric, prompt: "Pages"]; 

END. . . 



